home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / DialogS.tcl < prev    next >
Text File  |  1997-11-22  |  4KB  |  181 lines
  1. # The DialogShell widget lets the window manager know that it
  2. # is a dialog window. Among other things:
  3. #   -  It popups up automatically with requiring the user to hit the 
  4. #      mouse another time
  5. #   -  It centers itself over a parent widget
  6. #   -  It iconifies itself when the parent widget is iconifies
  7. # 
  8. #
  9. # Adapted from Joseph Wang's implementation for Tix 3.6. Rewritten to
  10. # follow the new OOP mechanism in Tix 4.0
  11. #
  12. # Original author:
  13. #
  14. # Written by Joseph Wang (joe@mit.edu)
  15. # Part of the Globewide Network Academy
  16. # Macvicar School of Education and Technology
  17. #
  18.  
  19. # If the user does not give value
  20. # the title and parent is dynamically configured.
  21. #
  22.  
  23. tixWidgetClass tixDialogShell {
  24.     -superclass tixShell
  25.     -classname  TixDialogShell
  26.     -method {
  27.     popdown popup center
  28.     }
  29.     -flag   {
  30.     -mapped -minheight -minwidth -parent -transient
  31.     }
  32.     -static {}
  33.     -configspec {
  34.     {-mapped mapped Mapped 0}
  35.     {-minwidth minWidth MinWidth 0}
  36.     {-minheight minHeight MinHeight 0}
  37.     {-transient transient Transient true}
  38.     {-parent parent Parent {}}
  39.     }
  40. }
  41.  
  42. #----------------------------------------------------------------------
  43. #        Construct widget
  44. #----------------------------------------------------------------------
  45.  
  46. proc tixDialogShell::ConstructWidget {w} {
  47.     upvar #0 $w data
  48.  
  49.     tixChainMethod $w ConstructWidget
  50.  
  51.     # Set the title of this shell appropriately
  52.     #
  53.     if {$data(-title) == {}} {
  54.     # dynamically sets the title
  55.     #
  56.     set data(-title) [winfo name $w]
  57.     }
  58.     wm title $w $data(-title)
  59.  
  60.     # Set the parent of this dialog shell
  61.     #
  62.     if {$data(-parent) == {}} {
  63.     set data(-parent) [winfo parent $w]
  64.     }
  65.  
  66.     # Set the minsize and maxsize of the thing
  67.     #
  68.     wm minsize $w $data(-minwidth) $data(-minheight)
  69. }
  70.  
  71. # The next procedures manage the dialog boxes
  72. #
  73. proc tixDialogShell::popup {w {parent {}}} {
  74.     upvar #0 $w data
  75.  
  76.     # First update to make sure the boxes are the right size
  77.     #
  78.     update idletask
  79.  
  80.     # Then we set the position and update
  81.     #
  82.     tixDialogShell::center $w $parent
  83.  
  84. #    if [winfo ismapped $w] {
  85. #    wm withdraw $w
  86. #    }
  87.  
  88.     # and now make it visible. Viola!  Centered over parent.
  89.     #
  90.     wm deiconify $w
  91. }
  92.  
  93. # This procedure centers a dialog box over a window making sure that the 
  94. # dialog box doesn't appear off the screen
  95. #
  96. # However, if the parent is smaller than this dialog, make this dialog
  97. # appear at parent(x,y) + (20,20)
  98. #
  99. proc tixDialogShell::center {w {parent {}}} {
  100.     upvar #0 $w data
  101.     # Tell the WM that we'll do this ourselves.
  102.     wm sizefrom $w user
  103.     wm positionfrom $w user
  104.  
  105.     if {$parent == {}} {
  106.     set parent $data(-parent)
  107.     }
  108.     if [catch {set parent [winfo toplevel $parent]}] {
  109.     set parent "."
  110.     }
  111.  
  112.     # Where is my parent and what are it's dimensions
  113.     #
  114.     if {$parent != ""} {
  115.     set pargeo [split [wm geometry $parent] "+x"]
  116.     set parentW [lindex $pargeo 0]
  117.     set parentH [lindex $pargeo 1]
  118.     set parx [lindex $pargeo 2]
  119.     set pary [lindex $pargeo 3]
  120.  
  121.     if {[tixGetBoolean -nocomplain $data(-transient)]} {
  122.         wm transient $w $parent
  123.     }
  124.     } else {
  125.     set parentW [winfo screenwidth $w]
  126.     set parentH [winfo screenheight $w]
  127.     set parx 0
  128.     set pary 0
  129.     set parent [winfo parent $w]
  130.     }
  131.  
  132.     # What are is the offset of the virtual window
  133.     set vrootx [winfo vrootx $parent]
  134.     set vrooty [winfo vrooty $parent]
  135.  
  136.     # What are my dimensions ?
  137.     set dialogW [winfo reqwidth $w]
  138.     set dialogH [winfo reqheight $w]
  139.  
  140.     if {$dialogW < [expr $parentW-30] || $dialogW < [expr $parentH-30]} {
  141.     set dialogx [expr $parx+($parentW-$dialogW)/2+$vrootx]
  142.     set dialogy [expr $pary+($parentH-$dialogH)/2+$vrooty]
  143.     } else {
  144.     # This dialog is too big. Place it at (parentx, parenty) + (20,20)
  145.     #
  146.     set dialogx [expr $parx+20+$vrootx]
  147.     set dialogy [expr $pary+20+$vrooty]
  148.     }
  149.  
  150.     set maxx [expr "[winfo screenwidth  $parent] - $dialogW"]
  151.     set maxy [expr "[winfo screenheight $parent] - $dialogH"]
  152.  
  153.     # Make sure it doesn't go off screen
  154.     #
  155.     if {$dialogx < 0} {
  156.     set dialogx 0
  157.     } else {
  158.     if {$dialogx > $maxx} {
  159.         set dialogx $maxx
  160.     }
  161.     }
  162.     if {$dialogy < 0} {
  163.     set dialogy 0
  164.     } else {
  165.     if {$dialogy > $maxy} {
  166.         set dialogy $maxy
  167.     }
  168.     }
  169.  
  170.     # set my new position (and dimensions)
  171.     #
  172.     if {[wm geometry $w] == "1x1+0+0"} {
  173.     wm geometry $w $dialogW\x$dialogH\+$dialogx\+$dialogy
  174.     }
  175. }
  176.  
  177. proc tixDialogShell::popdown {w args} {
  178.     wm withdraw $w
  179. }
  180.  
  181.